#lang errortrace racket
(require "hw5-util.rkt")
(require rackunit)

(define (quote-heap mem)
  (-> heap? list?)
  (quote-hash (heap-data mem) quote-handle (lambda (x) x) symbol<?))

;---------------------------------


(define (prog1 h1)
  ;; allocate x with 1
  (define eff-x (heap-alloc h1 1))
  (define x (eff-result eff-x))
  (define h2 (eff-state eff-x))
  ;; allocate y with 2
  (define eff-y (heap-alloc h2 2))
  (define y (eff-result eff-y))
  (define h3 (eff-state eff-y))
  ;; allocate z with (+ x y)
  (heap-alloc h3 (+ (heap-get h3 y) (heap-get h3 x))))

(define (run-state h op) (eff-state (op h)))

(check-equal?
  (eff-state (prog1 empty-heap))
  (run-state empty-heap prog1))

(define H (heap (hash (handle 0) 1 (handle 1) 2 (handle 2) 3)))

(check-equal? (run-state empty-heap prog1) H)


(define (num n)
  ; takes a heap -> produces an eff
  (lambda (h)
    (heap-alloc h n)))


(define (add x y)
  ; takes a heap -> produces an eff
  (lambda (h)
    (define v (+ (heap-get h y) (heap-get h x)))
    (heap-alloc h v)))



(define (prog2 h1)
  ; takes a heap -> produces an eff
  ;; allocate x with 1
  (define eff-x ((num 1) h1))
  (define x (eff-result eff-x))
  (define h2 (eff-state eff-x))
  ;; allocate y with 2
  (define eff-y ((num 2) h2))
  (define y (eff-result eff-y))
  (define h3 (eff-state eff-y))
  ;; allocate z with (+ x y)
  ((add x y) h3))

(check-equal? (run-state empty-heap prog2) H)



(define (bind heap-op cont)
  (lambda (h1)
    ; takes a heap -> produces an eff
    (define h2+result (heap-op h1))
    (define result (eff-result h2+result))
    (define h2 (eff-state h2+result))
    ((cont result) h2)))



(define prog3
  ; takes a heap -> produces an eff
  ;; allocate x with 1
  (bind (num 1)
    (lambda (x)
      (bind (num 2)
        (lambda (y)
          (add x y))))))


(check-equal? (run-state empty-heap prog3) H)

; ------------------------------------------------------------

#|
def mult():
  x = pop
  y = pop
  push (x * y)
def prog():
  push(2)
  push(5)
  mult() # 2 * 5 = 10
  push(2)
  mult()  # 10 * 2 = 20
|#

(define (pop)
  (lambda (h)
    (eff (rest h) (first h))))

(check-equal?
  (run-state (list 1 2 3) (pop))
  (list 2 3))

(define (push n)
  (lambda (h)
    (eff (cons n h) (void))))

(check-equal?
  (run-state (list 1 2 3) (push 10))
  (list 10 1 2 3))

#|
def mult():
  x = pop
  y = pop
  push (x * y)
|#

(define (mult)
  (bind (pop)
    (lambda (x)
      (bind (pop)
        (lambda (y)
          (push (* x y)))))))


(check-equal?
  (run-state (list 2 3) (mult))
  (list 6))

#|
def prog():
  push(2)
  push(5)
  mult() # 2 * 5 = 10
  push(2)
  mult()  # 10 * 2 = 20
|#

(define (prog)
  (bind (push 2)
    (lambda (x1)
      (bind (push 5)
        (lambda (x2)
          (bind (mult)
            (lambda (x3)
              (bind (push 2)
                (lambda (x4)
                  (mult))))))))))

(check-equal?
  (run-state (list) (prog))
  (list 20))

(define (seq op . l)
  (cond [(empty? l) op]
        [else
          (bind op (lambda (x)
            (apply seq l)))]))

(define (prog4)
  (seq
    (push 2)
    (push 5)
    (mult)
    (push 2)
    (mult)))

(check-equal?
  (run-state (list) (prog4))
  (list 20))


(define-syntax do
  (syntax-rules (<-)
    ; Only one monadic-op, return it
    [(_ mexp) mexp]
    ; A binding operation
    [(_ var <- mexp rest ...) (bind mexp (lambda (var) (do rest ...)))]
    ; No binding operator, just ignore the return value
    [(_ mexp rest ...)        (bind mexp (lambda (_) (do rest ...)))]))







;